Abstract
This project explores mobility in Washington, D.C. in normal coditions and during highly populated events that shock the system. Washington is significant as the city’s capital and therefore a host of major events. Washington is also known for the segregation, like many United States major cities. Because of these reasons, it is important to model mobility throughout the city and the metropolitan area. Specifically, this paper models normal traffic conditions in Washington and conditions during the 2017 inauguration and subsequent Women’s March by using Spacial Autoregressive Models.Data is taken from here from the “Travel Times” dataset for Boston. We want to look at how different transit policies impact the travel times within a city.
This research will first look at how travel times across Washington D.C. generally vary before and during the 2016 presidential election. We will then explore variations of this across different neighborhoods, income, and racial divides to examine bottlenecks in mobility for different identity groups. This research will contribute in explaining and interpreting variations in urban mobility during major events. It adds to the limited literature covering congestion capacity during agglomerating events such as the Olympics, natural disasters, and major holidays. It also aims to contribute by identifying heterogeneity across different socioeconomic barriers to better inform urban policy and planning aiming for equitable mobility.
This paper explores mobility in Washington, D.C. during major events such as the 2017 women’s march and inauguration. On January 20, 2017, Donald Trump was inaugurated in Washington. The following day, January 21, was the women’s march and protest against the new president. The women’s march in Washington has been called the largest protest in the United States with an estimated 470,000 people in attendence (Wallace and Parlapiano 2017). Crowd scientists estimate that the crowd at the Trump inauguration was about a third of the size, making it around 160,000 people (Wallace and Parlapiano 2017). We also examined the impact of demographic census data on travel time during normal conditions in the same time of year and then during the event to observe how demographics impact mobility and how those factors are exacerbated during major shocks to the system. We found that the number of roads, distance to the Washington Monument, and the number of black residents are consistently the most significant predictors of travel time to the Washington Monument. Further, we found that ________ ADD FINDINGS ABOUT SIGNIFICANCE DURING SHOCK!!!
It is important to examine urban mobility in two ways. First, city attributes such as road or transit access make certain areas more accessible. Unfortunately, accessibility or mobility can often fall along racial or class lines. Washington is highly segregated and by using a spacial autoregressive model on travel time to the Washington Monument during normal times, we are able to see the impact of race on D.C. area mobility. We observed that the population of black residents in a census tract is one of few significant variables in predicting travel time to the Washington Monument. Second, major increases in population during special events can shock the city’s infrastructure. For this reason, we looked at Washington because it is a city that is especially significant during major national events such as the inauguration and attracts huge numbers of additional visitors. We used a similar spacial autoregressive model for the week of the inauguration and Women’s March and then modeled the differences between the normal weeks and the inauguration and march to observe the shock on the system. Through modeling both before and during the major events, we were able to observe both demographic significance of travel time and the impact of major population changes on the system.
In order to examine the shock from these massive events, we used areal Uber data which includes travel times between various census tract locations in the DC metropolitan area. To model travel times before and during the event periods, we isolated a location and looked only at the travel time between each census tract in the Washington metropolitan area and the Washington Monument. We chose the Washington Monument as the destination because it is in the middle of the National Mall where many significant events including the inauguration and women’s march took place. Because the shape files are census tracts, we were able to include census information for each polygon through the tidycensus package. This data allowed us to address the impact of demographics on travel time.
According to the New York Times, crowd scientists estimated 470,000 people were at the women’s march in Washington on January 21st, 2017. They say that the crowd at the women’s march was about three times the size of the crowd at the Trump inauguration, making the crowd roughly 160,000 people at the Trump inauguration. https://www.nytimes.com/interactive/2017/01/22/us/politics/womens-march-trump-crowd-estimates.html The 2010 data set of demographic information by census tracts comes from Urban Institute:
dc_acs_tracts$centroids <- st_centroid(st_geometry(dc_acs_tracts), of_largest_polygon)
plot(st_geometry(dc_acs_tracts), border="grey")
plot(dc_acs_tracts$centroids, add=TRUE, col="blue", cex = 0.3)
centroids <- data.frame(cbind(st_coordinates(st_centroid(dc_acs_tracts))))
## Warning in st_centroid.sf(dc_acs_tracts): st_centroid assumes attributes
## are constant over geometries of x
centroids <- centroids %>%
mutate(GEOID = dc_acs_tracts$GEOID)
dc_acs_tracts <- left_join(x = dc_acs_tracts, y = centroids, by = "GEOID")
travel_time_sf <- left_join(x = travel_times_census_join, y = dc_acs_tracts, by = "GEOID") %>%
st_as_sf() %>%
st_transform(crs = 102285)
# Compute distance from Washington Monument
mnm <- tribble(
~latitude, ~longitude,
38.8895, -77.0353
)
mnm_sf <- mnm %>%
st_as_sf(coords = c("longitude", "latitude"), crs = 4326) %>%
st_transform(crs = 102285)
travel_time_sf <- travel_time_sf %>%
mutate(distance = st_distance(centroids, mnm_sf$geometry, by_element = TRUE),
march_inaug = ifelse((year == 2017 & month == 1 & week %in% c(3, 4)), 1, 0))
map_lims <- st_bbox(dc_acs_tracts)
travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
ggplot() +
geom_sf(mapping = aes(fill = mean_travel_time), lwd=0.2) +
geom_sf(data = travel_time_sf$centroids, cex = 0.5) +
scale_fill_viridis_c(direction = -1)
travel_time_sf %>% filter(year == 2017, month == 1, week == 4) %>%
ggplot() +
geom_sf(mapping = aes(fill = mean_travel_time), lwd=0.2) +
geom_sf(data = dc_roads, color = "white", lwd=0.2) +
geom_sf(data = metro_line, color = "black", lwd=0.2) +
theme_map +
coord_sf(xlim = c(map_lims["xmin"], map_lims["xmax"]), ylim = c(map_lims["ymin"], map_lims["ymax"])) +
scale_fill_viridis_c(direction = -1)
travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
ggplot() +
geom_sf(mapping = aes(fill = med_incomeE)) +
theme_map +
scale_fill_viridis_c()
travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
ggplot() +
geom_sf(mapping = aes(fill = blackE)) +
theme_map +
scale_fill_viridis_c()
travel_time_sf %>% filter(year == 2017, month == 1, week == 3) %>%
ggplot() +
geom_sf(mapping = aes(fill = car_transitE)) +
theme_map +
scale_fill_viridis_c()
travel_time_sf$NumRoads <- sapply(st_intersects(travel_time_sf,dc_roads),length)
travel_time_sf$NumMetro <- sapply(st_intersects(travel_time_sf,metro_line),length)
# Average travel times over weeks 1 and 2 in January (before inauguration)
weeks12 <- travel_time_sf %>%
filter(year %in% 2017) %>%
filter(month %in% 1) %>%
filter(week %in% 1:2) %>%
select(GEOID,mean_travel_time) %>%
as.data.frame() %>%
group_by(GEOID) %>%
summarize(MeanTimeNorm = mean(mean_travel_time))
weeks12_data <- travel_time_sf %>%
filter(year %in% 2017) %>%
filter(month %in% 1) %>%
filter(week %in% c(1:2)) %>%
distinct(GEOID, .keep_all = TRUE) %>%
dplyr::select(GEOID, starts_with('med_'), starts_with('white'), starts_with('asian'), starts_with('black'), starts_with('car_trans'), starts_with('public_trans'), NumRoads, NumMetro, distance) %>%
left_join(weeks12, by = 'GEOID')
# Average travel times over weeks 3 and 4 in January (during & after inauguration)
weeks34 <- travel_time_sf %>%
filter(year %in% 2017) %>%
filter(month %in% 1) %>%
filter(week %in% 3:4) %>%
select(GEOID,mean_travel_time) %>%
as.data.frame() %>%
group_by(GEOID) %>%
summarize(MeanTimeIng = mean(mean_travel_time))
weeks34_data <- travel_time_sf %>%
filter(year %in% 2017) %>%
filter(month %in% 1) %>%
filter(week %in% c(3:4)) %>%
distinct(GEOID, .keep_all = TRUE) %>%
dplyr::select(GEOID, starts_with('med_'), starts_with('white'), starts_with('asian'), starts_with('black'), starts_with('car_trans'), starts_with('public_trans'), NumRoads, NumMetro, distance) %>%
left_join(weeks34, by = 'GEOID')
# Take difference in average travel times before and after inauguration
weeksdiff <- left_join(weeks12, weeks34) %>%
mutate(diffMeanTime = MeanTimeIng - MeanTimeNorm)
## Joining, by = "GEOID"
weeksdiff_data <- travel_time_sf %>%
filter(year %in% 2017) %>%
filter(month %in% 1) %>%
filter(week %in% 1) %>%
dplyr::select(GEOID, med_incomeE, med_incomeM, asianE, asianM, blackE, blackM, public_transitE, public_transitM, car_transitE, car_transitM, NumRoads, NumMetro, distance) %>%
left_join(weeksdiff, by = 'GEOID')
Normal Mean Time Model
st_queen <- function(a, b = a) st_relate(a, b, pattern = "F***T****")
as.nb.sgbp <- function(x, ...) {
attrs <- attributes(x)
x <- lapply(x, function(i) { if(length(i) == 0L) 0L else i } )
attributes(x) <- attrs
class(x) <- "nb"
x
}
queen12 <- as.nb.sgbp(st_queen(weeks12_data))
W <- nb2mat(queen12, style='B', zero.policy = TRUE)
listW <- nb2listw(queen12)
dc_sar_12 <- spautolm(formula = MeanTimeNorm ~ med_incomeE + med_incomeM + asianE + asianM + blackE + blackM + public_transitE + public_transitM + car_transitE + car_transitM + NumRoads + NumMetro + distance, data = weeks12_data, listw = listW, family = "SAR")
summary(dc_sar_12)
##
## Call: spautolm(formula = MeanTimeNorm ~ med_incomeE + med_incomeM +
## asianE + asianM + blackE + blackM + public_transitE + public_transitM +
## car_transitE + car_transitM + NumRoads + NumMetro + distance,
## data = weeks12_data, listw = listW, family = "SAR")
##
## Residuals:
## Min 1Q Median 3Q Max
## -345.76964 -66.61612 0.92572 63.60008 405.12768
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.0831e+03 1.5961e+02 6.7863 1.150e-11
## med_incomeE -4.7538e-04 1.8551e-04 -2.5626 0.010388
## med_incomeM 1.7767e-03 6.4201e-04 2.7674 0.005651
## asianE -2.8622e-02 2.8789e-02 -0.9942 0.320119
## asianM 3.1822e-02 8.6564e-02 0.3676 0.713166
## blackE 2.2607e-02 8.9937e-03 2.5137 0.011947
## blackM -1.1687e-01 5.7145e-02 -2.0451 0.040847
## public_transitE 1.9083e-02 2.7433e-02 0.6956 0.486668
## public_transitM -8.3911e-02 1.3531e-01 -0.6201 0.535165
## car_transitE 1.0447e-02 1.5743e-02 0.6636 0.506960
## car_transitM -9.8756e-02 9.3609e-02 -1.0550 0.291435
## NumRoads -6.9817e+00 1.1923e+00 -5.8556 4.753e-09
## NumMetro -2.0462e+01 7.6550e+00 -2.6730 0.007517
## distance 2.0975e-02 6.7847e-03 3.0914 0.001992
##
## Lambda: 0.96863 LR test value: 989.99 p-value: < 2.22e-16
## Numerical Hessian standard error of lambda: 0.010293
##
## Log likelihood: -3373.246
## ML residual variance (sigma squared): 10677, (sigma: 103.33)
## Number of observations: 543
## Number of parameters estimated: 16
## AIC: 6778.5
# plot(weeks12["mean_travel_time"])
# plot(queen12, weeks12$centroids, col="blue", cex = 0.5, lwd = 0.5)
queen34 <- as.nb.sgbp(st_queen(weeks34_data))
W <- nb2mat(queen34, style='B', zero.policy = TRUE)
listW <- nb2listw(queen34)
dc_sar_34 <- spautolm(formula = MeanTimeIng ~ med_incomeE + med_incomeM + asianE + asianM + blackE + blackM + public_transitE + public_transitM + car_transitE + car_transitM + NumRoads + NumMetro + distance, data = weeks34_data, listw = listW, family = "SAR")
summary(dc_sar_34)
##
## Call: spautolm(formula = MeanTimeIng ~ med_incomeE + med_incomeM +
## asianE + asianM + blackE + blackM + public_transitE + public_transitM +
## car_transitE + car_transitM + NumRoads + NumMetro + distance,
## data = weeks34_data, listw = listW, family = "SAR")
##
## Residuals:
## Min 1Q Median 3Q Max
## -384.5352 -69.9064 2.0265 70.2418 393.8877
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.0859e+03 1.5044e+02 7.2186 5.254e-13
## med_incomeE -4.5296e-04 1.9116e-04 -2.3695 0.017813
## med_incomeM 1.5318e-03 6.6156e-04 2.3154 0.020589
## asianE -4.5941e-02 2.9666e-02 -1.5486 0.121477
## asianM 7.1844e-02 8.9211e-02 0.8053 0.420634
## blackE 2.7638e-02 9.2662e-03 2.9827 0.002857
## blackM -1.3682e-01 5.8901e-02 -2.3229 0.020184
## public_transitE 9.9672e-03 2.8267e-02 0.3526 0.724382
## public_transitM -3.7404e-02 1.3943e-01 -0.2683 0.788488
## car_transitE 5.7002e-03 1.6229e-02 0.3512 0.725407
## car_transitM -8.6745e-02 9.6463e-02 -0.8993 0.368517
## NumRoads -6.7050e+00 1.2284e+00 -5.4582 4.810e-08
## NumMetro -2.1325e+01 7.8862e+00 -2.7040 0.006850
## distance 2.1432e-02 6.9079e-03 3.1025 0.001919
##
## Lambda: 0.96501 LR test value: 979.66 p-value: < 2.22e-16
## Numerical Hessian standard error of lambda: 0.010737
##
## Log likelihood: -3393.998
## ML residual variance (sigma squared): 11330, (sigma: 106.44)
## Number of observations: 544
## Number of parameters estimated: 16
## AIC: 6820
# plot(weeks34["mean_travel_time"])
# plot(queen34, weeks34$centroids, col="blue", cex = 0.5, lwd = 0.5)
Difference Model
queen_diff <- as.nb.sgbp(st_queen(weeksdiff_data))
W <- nb2mat(queen_diff, style='B', zero.policy = TRUE)
listW <- nb2listw(queen_diff)
dc_sar_diff <- spautolm(formula = diffMeanTime ~ med_incomeE + med_incomeM + asianE + asianM + blackE + blackM + public_transitE + public_transitM + car_transitE + car_transitM + NumRoads + NumMetro + distance, data = weeksdiff_data, listw = listW, family = "SAR")
summary(dc_sar_diff)
##
## Call: spautolm(formula = diffMeanTime ~ med_incomeE + med_incomeM +
## asianE + asianM + blackE + blackM + public_transitE + public_transitM +
## car_transitE + car_transitM + NumRoads + NumMetro + distance,
## data = weeksdiff_data, listw = listW, family = "SAR")
##
## Residuals:
## Min 1Q Median 3Q Max
## -368.7223 -14.0757 -1.5434 14.7713 286.6781
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 4.8990e+01 1.4722e+01 3.3276 0.0008758
## med_incomeE -3.1150e-06 7.7097e-05 -0.0404 0.9677714
## med_incomeM -1.5106e-04 2.8573e-04 -0.5287 0.5970222
## asianE -2.0151e-02 1.1958e-02 -1.6852 0.0919438
## asianM 3.1413e-02 3.7841e-02 0.8301 0.4064620
## blackE 3.5201e-03 3.5790e-03 0.9836 0.3253298
## blackM -1.9259e-02 2.4939e-02 -0.7723 0.4399650
## public_transitE -4.9272e-03 1.1817e-02 -0.4169 0.6767172
## public_transitM 4.2836e-02 6.0303e-02 0.7103 0.4774927
## car_transitE -3.0538e-03 6.6778e-03 -0.4573 0.6474494
## car_transitM 8.1589e-03 4.1356e-02 0.1973 0.8436038
## NumRoads 3.8565e-01 4.8685e-01 0.7921 0.4282791
## NumMetro 8.2421e-03 3.1666e+00 0.0026 0.9979233
## distance -1.3050e-03 1.0770e-03 -1.2117 0.2256175
##
## Lambda: 0.61443 LR test value: 119.19 p-value: < 2.22e-16
## Numerical Hessian standard error of lambda: 0.046445
##
## Log likelihood: -2844.895
## ML residual variance (sigma squared): 1918.1, (sigma: 43.797)
## Number of observations: 543
## Number of parameters estimated: 16
## AIC: 5721.8
travel_time_sf_nontreat <- travel_time_sf %>%
filter(march_inaug == 0) %>%
group_by(GEOID) %>%
summarise(mtt_mean = mean(mean_travel_time),
mtt_var = var(mean_travel_time),
mtt_sd = sd(mean_travel_time),
NumRoads = log(mean(NumRoads) + 0.0001),
NumMetro = log(mean(NumMetro + 0.0001)))
travel_time_sf_nontreat %>%
ggplot() +
geom_sf(mapping = aes(fill = mtt_mean)) +
theme_map +
scale_fill_viridis_c()
travel_time_sf_nontreat %>%
ggplot() +
geom_sf(mapping = aes(fill = mtt_sd)) +
theme_map +
scale_fill_viridis_c()
travel_time_sf_nontreat %>%
ggplot() +
geom_sf(mapping = aes(fill = NumRoads)) +
theme_map +
scale_fill_viridis_c()
travel_time_sf_nontreat %>%
ggplot() +
geom_sf(mapping = aes(fill = NumMetro)) +
theme_map +
scale_fill_viridis_c()
Wallace, Tim, and Alicia Parlapiano. 2017. “Crowd Scientists Say Women’s March in Washington Had 3 Times as Many People as Trump’s Inauguration.” The New York Times. The New York Times. https://www.nytimes.com/interactive/2017/01/22/us/politics/womens-march-trump-crowd-estimates.html?searchResultPosition=1.